home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / write_tiff.pro < prev    next >
Text File  |  1997-07-08  |  9KB  |  262 lines
  1. ; $Id: write_tiff.pro,v 1.2 1997/01/15 03:11:50 ali Exp $
  2.  
  3. ; Copyright (c) 1991-1997. Research Systems, Inc. All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;+
  6. ; NAME:
  7. ;    WRITE_TIFF
  8. ;
  9. ; PURPOSE:
  10. ;    Write images in TIFF format.
  11. ;
  12. ; CATEGORY:
  13. ;    Input/output.
  14. ;
  15. ; CALLING SEQUENCE:
  16. ;    WRITE_TIFF, Filename, Array [, Orientation]
  17. ;
  18. ; INPUTS:
  19. ;     Filename:    A string containing the name of file to create. 
  20. ;
  21. ;    Array:    The image data to be written.  If not already a byte array,
  22. ;        it is made a byte array.  Array may be either an
  23. ;        [n, m] array for Grayscale or Palette classes, or
  24. ;        a [3, n, m] array for RGB full color, interleaved
  25. ;        by image.  If the PLANARCONFIG keyword (see below) is set
  26. ;        to 2 then the Array parameter is ignored (and may be
  27. ;        omitted). See PROCEDURE below for more information on
  28. ;        TIFF classes. 
  29. ;
  30. ; OPTIONAL INPUT PARAMETERS:
  31. ; Orientation:    This parameter should be 0 if the image is stored from bottom 
  32. ;        to top (the default).  For images stored from top to bottom, 
  33. ;        this parameter should be 1.  
  34. ;
  35. ;        WARNING:  Not all TIFF readers are capable of reversing the 
  36. ;        scan line order.  If in doubt, first convert the image
  37. ;        to top to bottom order (use the IDL REVERSE() function), and 
  38. ;        set Orientation to 1.
  39. ;
  40. ; OPTIONAL KEYWORD PARAMETERS:
  41. ; RED, GREEN, BLUE:
  42. ;        The color table vectors, scaled from 0 to 255 in the case of 
  43. ;        a Class P, Palette color image.  If, PlanarConfig is 2, these 
  44. ;        parameters must contain the 3 color component image parameters.
  45. ;
  46. ;        LONG:    If set, write the samples as 32 bit signed numbers.
  47. ; PLANARCONFIG:    Set this parameter to 2 if writing an RGB image that is 
  48. ;        contained in three separate images (color planes), specified
  49. ;        in the RED, GREEN, and BLUE parameters.  Otherwise, omit
  50. ;        this parameter (or set it to 1).
  51. ;
  52. ;        SHORT:    If set, write the samples as 16 bit signed numbers.
  53. ;        If neither SHORT or LONG are specified, write samples as
  54. ;        unsigned 8-bit numbers.
  55. ;    XRESOL:    The horizontal resolution, in pixels per inch.  The default
  56. ;        is 100.
  57. ; 
  58. ;    YRESOL:    The vertical resolution, in pixels per inch.  The default
  59. ;        is 100.
  60. ;
  61. ; OUTPUTS:
  62. ;    No explicit inputs.
  63. ;
  64. ; COMMON BLOCKS:
  65. ;    TIFF_COM.  Only for internal use.
  66. ;
  67. ; SIDE EFFECTS:
  68. ;    A file is created and written.
  69. ;
  70. ; RESTRICTIONS:
  71. ;    This procedure writes images in a single strip, or 3 strips when 
  72. ;    PLANARCONFIG is set to 2.  This procedure may cause readers with 
  73. ;    memory limitations problems.
  74. ;
  75. ; PROCEDURE/EXAMPLES:
  76. ;    Four types of TIFF files can be written:
  77. ;
  78. ;    TIFF Class G, Grayscale.  Array contains the 8-bit image array.
  79. ;    A value of 0 is black, 255 is white.  The Red, Green, and Blue
  80. ;    keywords are omitted.  Example:
  81. ;        WRITE_TIFF, 'a.tiff', Array
  82. ;
  83. ;    TIFF Class P, Palette Color.  Array contains the 8-bit image array.  
  84. ;    The keyword parameters RED, GREEN, and BLUE contain the color tables, 
  85. ;    which can have up to 256 elements, scaled from 0 to 255.  Example:
  86. ;        WRITE_TIFF, 'a.tiff', Array, RED = r, GREEN = g, BLUE = b
  87. ;
  88. ;    TIFF Class R, RGB Full Color, color interleaved by pixel.
  89. ;    Array contains the byte data, and is dimensioned [3, cols, rows].
  90. ;    Example:
  91. ;        WRITE_TIFF, 'a.tiff', Array
  92. ;
  93. ;    TIFF Class R, RGB Full Color, color interleaved by image.
  94. ;    Input is three separate images, provided in the keyword
  95. ;    parameters RED, GREEN, and BLUE.  The input parameter "Array"
  96. ;    is ignored.  The keyword PLANARCONFIG must be set to 2 in this case.
  97. ;    Example:
  98. ;        WRITE_TIFF, 'a.tiff', RED = r, GREEN = g, BLUE = b, PLAN = 2
  99. ;
  100. ; MODIFICATION HISTORY:
  101. ;    DMS, Written for VMS in 1985.
  102. ;
  103. ;    DMS, April, 1991.  Rewrote and added class R and P images.
  104. ;    DJC, Nov, 1993.  Fixed doc header.
  105. ;    DMS, Aug, 1995.  Added support for 16 and 32 bit samples.
  106. ;    SVP, Jan, 1997.  Changed from tiff_write to write_tiff
  107. ;-
  108. pro tiff_add_tag, lun, tag, value  ;Add a tag to the Image File Directory (IFD)
  109. common tiff_com, order, ifd, count
  110.  
  111. s = size(value)        ;Determine type from parameter
  112. typ = s[s[0]+1]        ;IDL type code
  113. tiff_typ = ([ 0, 1, 3, 4, 5, 0, 0, 2])[typ]  ;Tiff types vs IDL
  114. TypeLen = ([0, 1, 1, 2, 4, 8])[tiff_typ]
  115.  
  116. n = s[s[0]+2]        ; # of elements
  117. offset = count * 12 + 2    ; Offset into ifd
  118. ifd[offset] =   byte(fix(tag),0,2)    ;integer tag
  119. ifd[offset+2] = byte(tiff_typ, 0, 2)    ;data type
  120. ifd[offset+4] = byte(n,0,4)        ;count
  121. nbytes = n * TypeLen
  122.  
  123. if nbytes le 4 then begin    ;Simple case
  124.     ifd[offset+8] = byte(value,0,nbytes)
  125. endif else begin        ;Array, written to file
  126.     point_lun, -lun, pos   ;Get file posit
  127.     ifd[offset+8] = byte(pos, 0, 4)  ;Set IFD ^ pointer
  128.     if typ ne 4 then writeu, lun, value $    ;Write the data
  129.     else begin        ;Write floating
  130.         s = lonarr(n * 2)
  131.         s[indgen(n)*2] = value * 10000.  ;Arbritrary scale of 10000
  132.         s[indgen(n)*2+1] = 10000
  133.         writeu,lun, s
  134.     endelse
  135. endelse
  136. count = count + 1
  137. end
  138.  
  139.  
  140. pro write_tiff, filename, array, orientation, $
  141.     Red=red, Green=green, Blue=blue, Long=long, Short=short, $
  142.     PlanarConfig = PlanarConfig, Xresol = Xresol, Yresol = Yresol
  143. common tiff_com, order, ifd, count
  144.  
  145. on_error,2                      ;Return to caller if an error occurs
  146.  
  147. if n_elements(array) gt 0 then array = byte(array) ;Make sure it's byte
  148. s = size(array)
  149. if n_elements(PlanarConfig) le 0 then PlanarConfig = 1
  150.  
  151. color = 0            ;True if palette color with tables
  152.  
  153. if s[0] eq 3 then begin        ;True color image?
  154.     photo = 2
  155.     if s[1] ne 3 then message,'For true-color, image must be (3,n,m)'
  156.     cols = s[2]
  157.     rows = s[3]
  158.     samples = 3        ;3 samples / pixel
  159. endif else if PlanarConfig eq 2 then begin   ;RGB with separate sample planes
  160.     photo = 2
  161.     s = size(red)        ;Take image param from r,g,b
  162.     if s[0] ne 2 then message, 'Parameter must be 2D'
  163.     cols = s[1]
  164.     rows = s[2]
  165.     samples = 3
  166.     if (n_elements(red) ne n_elements(green)) or $
  167.         (n_elements(red) ne n_elements(blue)) then $
  168.         message,'Image components must have same size'
  169. endif else begin        ;Assume must be palette
  170.     if s[0] ne 2 then message, 'Parameter must be 2D'
  171.     cols = s[1]
  172.     rows = s[2]
  173.     samples = 1
  174.     if (n_elements(red) ne n_elements(green)) or $
  175.         (n_elements(red) ne n_elements(blue)) then $
  176.             message,'Color tables must have same size'
  177.     color = N_elements(red) GT 0
  178.     if color then photo = 3 else photo = 1
  179. endelse
  180.  
  181. if n_elements(orientation) eq 0 then orientation = 0
  182.  
  183. if (!version.os EQ 'MacOS') then begin
  184. openw, lun, filename, /BLOCK, /GET_LUN, MACTYPE = "TIFF"
  185. endif else begin
  186. openw, lun, filename, /BLOCK, /GET_LUN
  187. endelse
  188. header = bytarr(8)        ;The Tiff header
  189.  
  190. if keyword_set(long) then nbits = 32 $   ;Type of data for samples
  191. else if keyword_set(short) then nbits = 16 $
  192. else nbits = 8
  193. fcn_name = (['BYTE','FIX','', 'LONG'])[nbits/8-1]  ;Sample conversion function
  194.  
  195. tst = byte(1,0,2)        ;Which endian???
  196. if tst[0] eq 1 then header[0] = byte("II") $    ;Little endian
  197.    else header[0] = byte("MM")    ;Big endian
  198.  
  199. header[2] = byte(42,0,2)    ;Version = 42
  200.  
  201. writeu, lun, header
  202.  
  203. ifd = bytarr(512)        ;Image file directory
  204. count = 0            ;# of tags
  205.  
  206. tiff_add_tag, lun, 254, 0L        ;New Subfile type
  207. tiff_add_tag, lun, 256, long(cols)    ;Image width
  208. tiff_add_tag, lun, 257, long(rows)    ;Image height
  209.  
  210. tiff_add_tag, lun, 258, replicate(nbits,samples)  ;bit/sample
  211. tiff_add_tag, lun, 259, 1        ;No compression
  212. tiff_add_tag, lun, 262, photo    ;Photometric Interpretation
  213. nbytes = rows * cols * (nbits/8)    ;Bytes / plane
  214.  
  215. ; Write image data......
  216. point_lun, -lun, faddr        ;Get current file position
  217. if PlanarConfig eq 2 then begin ; write R,G,B in separate planes
  218.     tiff_add_tag, lun, 273, faddr + [0,1,2] * nbytes + 12  ;Strip offsets
  219.     writeu, lun, call_function(fcn_name, red)
  220.     writeu, lun, call_function(fcn_name, green)
  221.     writeu, lun, call_function(fcn_name, blue)
  222. endif else begin        ;Write image as one chunk
  223.     tiff_add_tag, lun,273, faddr  ;Strip offset
  224.     writeu, lun, call_function(fcn_name, array)
  225. endelse
  226.  
  227. tiff_add_tag, lun, 274, fix(4 - 3 * (orientation and 1)) ;Orientation  
  228. tiff_add_tag, lun, 277, samples    ;Samples / pixel
  229. tiff_add_tag, lun, 278, rows        ;Rows / strip
  230.  
  231. if PlanarConfig eq 2 then  t = replicate(nbytes, samples) $ ;Strip byte cnts
  232. else t = samples * nbytes
  233. tiff_add_tag, lun, 279,  t  ;Strip byte counts 
  234.  
  235. if n_elements(xresol) le 0 then xresol = 100.
  236. if n_elements(yresol) le 0 then yresol = 100.
  237. tiff_add_tag, lun, 282, float(xresol)        ;Xresolution
  238. tiff_add_tag, lun, 283, float(yresol)        ;... and Yresolution
  239. tiff_add_tag, lun, 284, PlanarConfig ;PlanarConfig
  240.  
  241. IF (photo EQ 3) THEN BEGIN    ;Add colormap?
  242.     rgb_array = intarr(768)    ;Make the color maps
  243.     rgb_array[0] = ishft(fix(red),8)  ;Scale up to 65K max
  244.     rgb_array[256] = ishft(fix(green), 8)
  245.     rgb_array[512] = ishft(fix(blue),8)
  246.     tiff_add_tag, lun, 320, rgb_array
  247.     ENDIF
  248.  
  249.  
  250. point_lun, -lun, faddr        ;Write IFD at and, get addr
  251. ifd[0] = byte(count,0,2)    ;Insert count
  252. writeu, lun, ifd[0: count*12+5] ;Write IFD followed by 4 zero bytes
  253.  
  254. point_lun, lun, 0        ;Rewind to header
  255. header[4] = byte(faddr,0,4)    ;Write ifd offset
  256. writeu, lun, header        ;And save it
  257.  
  258. free_lun,lun            ;Done
  259. end
  260.         
  261.  
  262.